home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / match.com / MATCH.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1989-05-25  |  3.3 KB  |  180 lines
  1.  
  2. {****************************************************************************
  3.  
  4.  
  5.        MatchStr: Public Domain, May 3, 1989. Written by Tom Guinther
  6.  
  7.  
  8. ****************************************************************************}
  9.  
  10.  
  11.  
  12.  
  13. Unit MatchStr;
  14.  
  15.  
  16.  
  17. Interface
  18.  
  19.  
  20.  
  21. Function Match(S, MS : String) : Boolean;
  22. Function MatchFileName(FileName, MS : String) : Boolean;
  23.  
  24.  
  25.  
  26. Implementation
  27.  
  28.  
  29.  
  30. Function Min(A, B : Byte) : Byte;
  31. Begin
  32.  
  33.    If A < B then
  34.     Min := A
  35.    Else
  36.     Min := B;
  37.  
  38. End;
  39.  
  40.  
  41.  
  42. {****************************************************************************
  43.  
  44.    Match: Match the string S to the string MS. MS may include the DOS 
  45.           wildcard characters '*' and '?'.
  46.  
  47. ****************************************************************************}
  48.  
  49. Function Match(S, MS : String) : Boolean;
  50. Var
  51.   I,
  52.   MinLen : Byte;
  53.   Done   : Boolean;
  54.  
  55. Begin
  56.  
  57.   Match := False;
  58.  
  59.   I      := 0;
  60.   MinLen := Min(Length(S),Length(MS));
  61.   Done   := False;
  62.  
  63.   While((NOT Done) and (I < MinLen)) Do
  64.   Begin
  65.  
  66.        Inc(I);
  67.  
  68.        Case(MS[I]) of
  69.  
  70.          '*' : Done := True;
  71.          '?' : ;
  72.  
  73.          Else
  74.            If MS[i] <> S[I] Then
  75.              Exit;
  76.  
  77.  
  78.        End;
  79.  
  80.   End;
  81.  
  82.   Match := True;
  83.  
  84.  
  85. End;
  86.  
  87.  
  88.  
  89. {****************************************************************************
  90.  
  91.   MatchFileName:
  92.  
  93.      Match the string FileName against the spec string MS. MS may contain
  94.      the DOS wildcard characters '*' and '?'.
  95.  
  96.      Examples   MatchFileName('TEST.PAS','*.?as') = True;
  97.                 MatchFileName('TEST','*.')        = True;
  98.                 MatchFileName('TEST.C','T*.*')    = True;
  99.  
  100. ****************************************************************************}
  101.  
  102. Function MatchFileName(FileName, MS : String) : Boolean;
  103. Var
  104.   Name,
  105.   Ext,
  106.   MSName,
  107.   MSExt    : String;
  108.  
  109.   P        : Byte;
  110.  
  111.   Result   : Boolean;
  112.  
  113. Begin
  114.  
  115.   Result := True;  { Assume the best since we will be using a Boolean AND }
  116.  
  117.  
  118.   { Prep the file name }
  119.  
  120.   P := Pos('.',FileName);
  121.  
  122.   If P = 0 Then
  123.     P := Length(FileName)+1;
  124.  
  125.   Name := Copy(FileName,1,P-1);
  126.   Ext  := Copy(FileName,P+1,3);
  127.  
  128.  
  129.   { Prep Search String }
  130.  
  131.   P := Pos('.',MS);
  132.  
  133.   If P = 0 Then
  134.     P := Length(FileName)+1;
  135.  
  136.   MSName := Copy(MS,1,P-1);
  137.   MSExt  := Copy(MS,P+1,3);
  138.  
  139.  
  140.   {*******************************************************************
  141.  
  142.     Special Cases:
  143.  
  144.             1)  Looking for *. and file has valid extension,
  145.                 which will result in Match = False. But,
  146.                 this is actually a valid DOS match.
  147.  
  148.             2)  Looking for *.* or *.? etc when filename doesn't
  149.                 have an extension. Match = False, but assuming that
  150.                 MSExt is entirly made up of wildcards, we have a
  151.                 valid DOS match.
  152.  
  153.     Result:
  154.  
  155.             If either MSext or Ext are empty ('') then they are
  156.             set = to 3 spaces ('   '); this gaurentees that both
  157.             cases will return the proper results.
  158.  
  159.  
  160.   ********************************************************************}
  161.  
  162.   If Length(Ext) = 0 Then
  163.     Ext := '   ';
  164.  
  165.   If Length(MSExt) = 0 Then
  166.     MSExt := '   ';
  167.  
  168.   Result := Match(Name,MSName);
  169.  
  170.   If (Result) Then
  171.     Result := Result and Match(Ext,MSExt);
  172.  
  173.   MatchFileName := Result;
  174.  
  175. End;
  176.  
  177.  
  178.  
  179. End.  { Implementation }
  180.